#!/usr/bin/perl 
BEGIN {
    push @INC, '/home/xuqy/dmoz/modules';
}
use warnings;
use strict;
use YAML;
use DB_File;
use MLDBM qw(DB_File Storable);
use URI;
use HTML::TreeBuilder;
use FocusCrawler::FirstOrder::DomParser;

my $config_file = shift;
my %params = %{YAML::LoadFile($config_file)};

tie my %digests,    'DB_File', $params{digest_db_file}  or die "$!";
tie my %dumps ,     'MLDBM',   $params{dump_db_file}    or die "$!";

my $max_depth = $params{max_depth};
my $facts_fh;
my (%tokens_raw, %tokens);
my (%elem2tokens, %digest2pair);

my $max_children_cnt = $params{max_children_cnt};

my $total_pos_cnt = 0;
print "Start building index...\n";
{
    my @labels;
    while (my($digest, $dump_ref) = each %dumps) {
        my $label = $dump_ref->{label};
        $label = $label eq '-' ? '-' : '+';
        $total_pos_cnt++ if $label eq '+';
        push @labels, $label;
	    $digest2pair{$digest}  = [$#labels, $label];
    }
    YAML::DumpFile($params{labels_file}, \@labels);
}
my $min_pos_cover = $params{min_pos_cover} * $total_pos_cnt;
print "Done!\n";

print "Start preprocessing...\n";
pre_process();
print "Done!\n";

print "Start feature selecting...\n";
print "Tokens raw: ", scalar keys %tokens_raw, "\n";
while (my($token, $info) = each %tokens_raw) {
    if ($info eq '-1') {
        $tokens{$token} = 1;
    }
}
%tokens_raw = ();

printf "Tokens selected: %d\n", scalar(keys %tokens);

YAML::DumpFile($params{tokens_file}, \%tokens);
print "Done!\n";

print "Start postprocessing...\n";

open  $facts_fh, "> $params{facts_file}" or die "$!";
print $facts_fh ":- discontiguous $_.\n" for qw(link/2 parent/3 child/3 text/2 url/2 only/1 target/1);

my $parser = new FocusCrawler::FirstOrder::DomParser \%tokens, \&anchor2page, \&facts_handler, \&anchor2target;
my $next_elem_index = 0;
my $index = 0;
while (my($digest, $dump_ref) = each %dumps) {
    $index++;
    print "Record $index\n" unless $index % 100;
    next if $dump_ref->{no_follow} or $dump_ref->{label} eq '-';
    my ($content, $base) = @$dump_ref{'content', 'base'}; 
    $next_elem_index = $parser->process($content, $base, $digest, $next_elem_index);
}
close $facts_fh;
print "Done!\n";

untie %digests;
untie %dumps;

print "All Done!\n";

sub pre_process {
    my $count = 0;
    while ( my($digest, $dump_ref) = each %dumps) {
        $count++;
        print "Record: $count\n" unless $count % 100;

        next if $dump_ref->{no_follow};

        my ($digest_index, $label) = @{$digest2pair{$digest}};
        next unless $label eq '+';

        %elem2tokens = ();

        my $content = &get_filtered_content($dump_ref->{content});
        my $base = $dump_ref->{base};

        my $parser = HTML::TreeBuilder->new_from_content($content);
        $parser->attr_encoded(1);
        my @anchors = $parser->find_by_tag_name('a');

        foreach my $anchor (@anchors) {
            my $new_digest_index = &anchor2page($anchor, $base, $digest);
            next unless defined $new_digest_index;
            if (&anchor2target($anchor, $base)) {
                &process_anchor($anchor, $new_digest_index, $base);
            }
        }
        $parser->delete;
    }
}

sub process_anchor {
    my ($anchor, $digest_index, $base) = @_;

    my $path = 'link:a';

    &process_elem($anchor, $path, $digest_index, $base);

    my ($elem, $depth, $last_elem) = ($anchor, 0);
    while ($depth < $max_depth and $elem->tag ne 'body') {
        $last_elem = $elem;
        $elem = $elem->parent;
        $path .= ' parent:'.$elem->tag;
        $depth++;
        &process_elem($elem, $path, $digest_index, $base);
        my @offsprings = map { [$_, $path.' child:'.$_->tag, $depth+1] } grep { ref $_ and $_ ne $last_elem } $elem->content_list if $depth < $max_depth;
        my $pindex = $last_elem->pindex();
        my $width = $max_children_cnt / 2;
        @offsprings = @offsprings[($pindex < $width ? 0 : $pindex - $width) .. ($pindex + $width > $#offsprings ? $#offsprings : $pindex + $width)];
        while (@offsprings) {
            my ($offspring, $this_path, $this_depth) = @{pop @offsprings};
            &process_elem($offspring, $this_path, $digest_index, $base);
            my @entries = map { [$_, $this_path.' child:'.$_->tag, $this_depth+1] } grep { ref $_ } $offspring->content_list if $this_depth < $max_depth;
            @entries = @entries[0..($max_children_cnt - 1)] if @entries > $max_children_cnt;
            push @offsprings, @entries;
        }
    }
}

sub process_elem {
    my ($elem, $path, $digest_index, $base) = @_;
    &fill_tokens_raw($path, $digest_index);
    my $text_tokens_ref = $elem2tokens{$elem};
    unless (defined $text_tokens_ref) {
        $text_tokens_ref = &get_tokens_from_elem($elem);
        $elem2tokens{$elem} = $text_tokens_ref;
    }
    &fill_tokens_raw("$path text:$_", $digest_index) for @$text_tokens_ref;
    if ($elem->tag eq 'a') {
        if ($path eq 'link:a') {
            &fill_tokens_raw("$path url:$_", $digest_index) for @{&get_tokens_from_text(&get_url($elem, $base))};
        }
#        if (&anchor2target($elem, $base)) {
#            my $new_digest = &get_digest($elem, $base);
#            my $new_digest_index = $digest2pair{$new_digest}[0];
#            &fill_tokens_raw("$path target", $digest_index) if $new_digest_index ne $digest_index;
#        }
    }
    if ($elem->content_list == 1 and ref(($elem->content_list)[0])) {
        &fill_tokens_raw("$path only", $digest_index);
    }
}

sub fill_tokens_raw {
    my ($token, $digest_index) = @_;
    my $indexes_line = $tokens_raw{$token} || '';
    return if $indexes_line eq '-1';
    my $cnt = $indexes_line =~ tr/ / /;
    if ($cnt > $min_pos_cover) {
        $tokens_raw{$token} = '-1';
    }
    else {
        $tokens_raw{$token} = $indexes_line."$digest_index " unless $indexes_line =~ /\b$digest_index\b/;
    }
}

sub get_digest {
    my ($anchor, $base) = @_;
    my $url = &get_url($anchor, $base);
    return undef unless defined $url;
    return $digests{$url};
}

sub anchor2page {
    my ($anchor, $base, $digest) = @_;
    my $new_digest = &get_digest($anchor, $base);
    return undef if not defined $new_digest or $new_digest eq $digest;
    return $digest2pair{$new_digest}[0];
}

sub anchor2target {
    my ($anchor, $base) = @_;
    my $new_digest = &get_digest($anchor, $base);
    return 0 if not defined $new_digest;
    my $dump_ref = $dumps{$new_digest};
    defined $dump_ref and $dump_ref->{label} ne '-';
}

sub facts_handler {
    my $fact = shift;
    print $facts_fh "$fact.\n";
}
